library(tidyverse)
library(openxlsx)
library(gt)
library(modeltime)
library(timetk)
library(sknifedatar)
library(tidymodels)
library(feasts)
library(forecast)
library(tsibble)
library(fable)
library(fabletools)
library(urca)
library(plotly)Trabajo final 7
Estructuración de base de datos
CONSOLIDADO <- read.xlsx("C:\\Users\\admin\\OneDrive - Universidad Central del Ecuador\\Escritorio\\IESS\\Trabajo4_Pronostico\\Data\\PORTAFOLIO_CONSOLIDADO_PROYECCION.xlsx",
detectDates = T)
CONSOLIDADO1 <- CONSOLIDADO %>% pivot_longer(!INVERSION,
names_to = "FECHA",
values_to = "RENDIMIENTOS")%>%
mutate(FECHA = as.Date(FECHA))
listas <- split(CONSOLIDADO1,CONSOLIDADO1$INVERSION)
IP <- listas$PRIVATIVAS[-1]#PRIVATIVASVisualizando base de datos
tabla2 <- IP %>%
gt() %>%
tab_header(title='Inversiones privativas',
subtitle='Portafolio IESS') %>%
fmt_number(
columns = vars(RENDIMIENTOS),
decimals = 2,
suffixing = TRUE,
use_seps = TRUE
) %>%
tab_footnote(
footnote = "Fuente: Histórico portafolio")%>%
tab_footnote(
footnote = "Elaborado por: Víctor Vallejo")
gtsave(tabla2, file = "t2.html")- Para la presente aplicación se cuenta con una serie histórica sobre inversiones privativas pertenecientes al IESS la cual va desde Diciembre 2013 hasta marzo 2023 con una periodicidad de tipo mensual.
Visualización gráfica de la serie
IP %>%
plot_time_series(.date_var = FECHA,
.value = RENDIMIENTOS,
.interactive = T,
.line_size = 0.15,.title = "Evolución inversiones privativas",.x_lab = "Tiempo",.y_lab = "Valores")- Se puede apreciar que la serie en estudio cuenta con un fuerte componente tendencial, creciente durante los meses, con pequeñas caidas a lo largo del año 2021, con esto ya da luces que las inversiones privativas no presentan un comportamiento estacional a lo largo de los años.
Contraste de hipótesis sobre estacionariedad
Phillips-Perron
\(H_0:\) Raíz unitaria (No estacionariedad)
\(H_1:\) No raíz unitaria estacionariedad
testpp <- ur.pp(tsdata,
type = c("Z-tau"),
model = c("trend"),
lags = c("short"))
summary(testpp)
##################################
# Phillips-Perron Unit Root Test #
##################################
Test regression with intercept and trend
Call:
lm(formula = y ~ y.l1 + trend)
Residuals:
Min 1Q Median 3Q Max
-161439916 -20628301 8513409 27379920 89930829
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.884e+08 7.186e+07 4.014 0.000111 ***
y.l1 9.753e-01 7.716e-03 126.401 < 2e-16 ***
trend 4.060e+05 4.256e+05 0.954 0.342146
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 41380000 on 108 degrees of freedom
Multiple R-squared: 0.9994, Adjusted R-squared: 0.9994
F-statistic: 9.769e+04 on 2 and 108 DF, p-value: < 2.2e-16
Value of test-statistic, type: Z-tau is: -2.5551
aux. Z statistics
Z-tau-mu 2.4958
Z-tau-beta 0.9957
Critical values for Z statistics:
1pct 5pct 10pct
critical values -4.042903 -3.450435 -3.150299
- Como el valor de tabla |-2.5551| no es mayor a ninguno de los valores criticos(-4.134754, -3.493511, -3.175277), entonces no se puede rechazar Ho por lo que se dice que hay raíz unitaria o la serie no es estacionaria.
Elliot, Rothenberg and Stock Unit Root Test
\(H_0:\) Raíz unitaria (No estacionariedad)
\(H_1:\) No raíz unitaria estacionariedad
erstest <- ur.ers(tsdata,
type = c("DF-GLS"),
model = c("trend"),
lag.max = 4)
summary(erstest)
###############################################
# Elliot, Rothenberg and Stock Unit Root Test #
###############################################
Test of type DF-GLS
detrending of series with intercept and trend
Call:
lm(formula = dfgls.form, data = data.dfgls)
Residuals:
Min 1Q Median 3Q Max
-157929887 -18068835 3871461 19257608 92669508
Coefficients:
Estimate Std. Error t value Pr(>|t|)
yd.lag -0.005848 0.005932 -0.986 0.3265
yd.diff.lag1 0.435966 0.097769 4.459 2.12e-05 ***
yd.diff.lag2 0.023942 0.104776 0.229 0.8197
yd.diff.lag3 0.203372 0.104237 1.951 0.0538 .
yd.diff.lag4 0.137567 0.097609 1.409 0.1618
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 39840000 on 102 degrees of freedom
Multiple R-squared: 0.4361, Adjusted R-squared: 0.4085
F-statistic: 15.78 on 5 and 102 DF, p-value: 1.74e-11
Value of test-statistic is: -0.9859
Critical values of DF-GLS are:
1pct 5pct 10pct
critical values -3.46 -2.93 -2.64
- Como el valor de tabla |-0.9859| no es mayor ninguno de los valores críticos (-3.46,-2.93,-2.64). Entonces no se puede rechazar Ho por lo que se dice que hay raíz unitaria o la serie no es estacionaria.
Descomposición de la serie de tiempo
- En el gráfico adjunto se pueden apreciar la descomposición de la serie de tiempo(tendencia, estacionalidad y ruído). Como ya se había comentado antes, la serie presenta un fuerte componente tendencial, con la descomposición se puede apreciar que pareciera no haber estacionalidad en la serie.
Estacionalidad de la serie
- Analizando mas detalladamente la estacionalidad de manera gráfica, se puede observar que en todos los años el comportamiento se mantiene similar, no hay un comportamiento a parte de manera mensual ni trimestral.
Función de autocorrelación simple y parcial
- Considerando el comportamiento bastante particular de la la función de autocorrelación simple no queda claro el número de rezagos para la media móvil para considerar en un eventual modelo ARIMA.
Modelamiento de la serie
- Para este apartado dada las caracteristicas de la seria se hará uso de un modelo ‘Holt-winters doble’ sobre el cual se pretende modelar el componente tendencial de la serie para ser usada luego para pronóstico.
modeloIP <- HoltWinters(tsdata,gamma = 0)#Mejor modelo para inversiones privativas
modeloIPHolt-Winters exponential smoothing with trend and additive seasonal component.
Call:
HoltWinters(x = tsdata, gamma = 0)
Smoothing parameters:
alpha: 1
beta : 0.1208015
gamma: 0
Coefficients:
[,1]
a 1.168255e+10
b 4.189690e+07
s1 -2.012820e+07
s2 -3.182958e+07
s3 -7.185083e+07
s4 -2.433689e+07
s5 -4.136174e+04
s6 3.815950e+07
s7 5.250430e+07
s8 5.350019e+07
s9 3.107170e+07
s10 1.497194e+07
s11 -2.814405e+07
s12 -1.387672e+07
Pronóstico
forecast(modeloIP,h = 9,level = 95,alpha = 0.05) Point Forecast Lo 95 Hi 95
Apr 2023 11704321036 11530922671 11877719402
May 2023 11734516550 11474061124 11994971977
Jun 2023 11736392198 11398475576 12074308819
Jul 2023 11825803034 11413496873 12238109195
Aug 2023 11891995461 11406052310 12377938612
Sep 2023 11972093217 11412184023 12532002412
Oct 2023 12028334920 11393554183 12663115657
Nov 2023 12071227707 11360338744 12782116669
Dec 2023 12090696114 11302263847 12879128381
autoplot(forecast(modeloIP,h = 9,level = 95,alpha = 0.05))+
labs(title = "Pronóstico inversiones privativas Abril2023-Diciembre2023",
subtitle = "Suavización exponencial doble(Hold)",
x = "Tiempo",
y = "Valores",
caption = "Fuente: Histórico portafolio \n Elaboración: Víctor Vallejo") - Con base en los pronósticos realizados para los meses de abril 2023 a Diciembre 2023, se puede apreciar que dichos valores comparte conservadoramente la tendencia de la serie original.